!! Copyright (C) 2012, 2013  Carlo de Falco
!!
!! This file is part of:
!!   FEMilaro -- Finite Element Method toolkit
!!
!! FEMilaro is free software; you can redistribute it and/or modify it
!! under the terms of the GNU General Public License as published by
!! the Free Software Foundation; either version 3 of the License, or
!! (at your option) any later version.
!!
!! FEMilaro is distributed in the hope that it will be useful, but
!! WITHOUT ANY WARRANTY; without even the implied warranty of
!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
!! General Public License for more details.
!!
!! You should have received a copy of the GNU General Public License
!! along with FEMilaro; If not, see <http://www.gnu.org/licenses/>.
!!
!! author: Carlo de Falco

!>\brief
!! Write variables in octave binary form (compressed or not). 
!!
!! \n
!!
!! Read and write variables in octave compressed binary form. Octave
!! (>= 3.6) headers and libraries must be installed in order to build
!! and use this module.
!!
!! When reading array variables, they are allocated according to the
!! contents of the input file; in particular, <tt>allocatable</tt>
!! arguments are expected.
!!
!! Unlike other IO modules in FEMilaro it does not expect user to pass
!! an open File Unit, because it relies on C++ \c fiostream to handle
!! files and on \c liboctave methods for data formatting and
!! compression. See the comments in \c octave_io_open for further
!! details.
!<----------------------------------------------------------------------
module mod_octave_io_binary

!-----------------------------------------------------------------------
  
 use, intrinsic :: iso_c_binding

 use mod_messages, only:        &
   mod_messages_initialized, &
   error,                    &
   warning,                  &
   info
 
 use mod_kinds, only:        &
   mod_kinds_initialized, &
   wp

!-----------------------------------------------------------------------

 implicit none

!-----------------------------------------------------------------------

! Module interface

 public :: &
   octave_binary_open,                &
   octave_binary_close,               &
   !mod_octave_io_binary_constructor, & !! TODO unimplemented methods
   !mod_octave_io_binary_destructor,  &
   !mod_octave_io_binary_initialized, &
   write_octave_binary,               &
   read_octave_binary_al

 private
 
!-----------------------------------------------------------------------

 !> Work variable for many subroutines
 character(len=255) :: text

!-----------------------------------------------------------------------
  
 ! Interfaces for C++ functions linking to Octave internals.

 !> Open a C++ fstream and associate it with an Octave binary file. 
 !!
 !! This function should be used instead of <tt>open(unit,file)</tt>
 !! to work with octave binary files. This is because it allocates an
 !! \c octave_file_io_intf object. Correspondingly, the file should
 !! then be closed with \c octave_io_close instead of using
 !! <tt>close(unit)</tt>.
 !!
 !! \note Only one file at the time can be opened.
 !!
 !! \c mode_in is an integer parameter defined as follows:
 !! <table>
 !!  <tr> <td> 0 </td> <td> read uncompressed  </td> </tr>
 !!  <tr> <td> 1 </td> <td> read compressed    </td> </tr>
 !!  <tr> <td> 2 </td> <td> write uncompressed </td> </tr>
 !!  <tr> <td> 3 </td> <td> write compressed   </td> </tr>
 !! </table>
 !!
 !! If trying to open an existing file and the compression part of \c
 !! mode_in does not correspond with the existing file, the return a
 !! positive integer, change the compression part in order to open the
 !! existing file and return the cerreced mode in \c mode_out.
 interface 
  function octave_io_open (filename, mode_in, mode_out) &
       bind(c, name="octave_io_open")
    
   import :: c_int, c_char
   implicit none
    
   integer(c_int) :: octave_io_open
    
   character(kind=c_char), intent(in) :: filename(*)
   integer(c_int), intent(in) :: mode_in
   integer(c_int), intent(out) :: mode_out
    
  end function octave_io_open
 end interface
  
!-----------------------------------------------------------------------

 !> Close the C++ fstream
 interface 
  function octave_io_close () &
       bind(c, name="octave_io_close")

   import :: c_int
   implicit none

   integer(c_int) :: octave_io_close
           
  end function octave_io_close
 end interface

!-----------------------------------------------------------------------

 !> Load data from a binary Octave file.
 interface 
  function octave_load (varname, data, rank, shape) &
       bind(c, name="octave_load")

   import :: c_int, c_char, c_ptr
   implicit none

   integer(c_int) :: octave_load
   
   character(kind=c_char), intent(in) :: varname(*)
   
   type(c_ptr), intent(out) :: data
   integer(c_int), intent(out) :: rank
   integer(c_int), intent(out), dimension (*) :: shape
   
  end function octave_load
 end interface

!-----------------------------------------------------------------------

 !> Save data to a binary Octave file.
 interface 
  function octave_save (varname, data, rank, shape) &
       bind(c, name="octave_save")

   import :: c_int, c_double, c_char
   implicit none

   integer(c_int) :: octave_save
   
   character(kind=c_char), intent(in) :: varname(*)
   
   real(c_double), intent(in), dimension (*) :: data
   integer(c_int), intent(in) :: rank
   integer(c_int), intent(in), dimension (*) :: shape
    
  end function octave_save
 end interface

!-----------------------------------------------------------------------

 !> Free memory from octave IO buffer
 interface 
  function octave_clear () &
       bind(c, name="octave_clear")

   import :: c_int
   implicit none
   integer(c_int) :: octave_clear
  end function octave_clear
 end interface

!-----------------------------------------------------------------------

 interface read_octave_binary_al
  module procedure read_vect_al_r, read_mat_al_r, read_scal_r
 end interface read_octave_binary_al

 interface write_octave_binary
  module procedure write_vect_r, write_mat_r, write_scal_r
 end interface write_octave_binary

!-----------------------------------------------------------------------
  
contains
  
!-----------------------------------------------------------------------

 subroutine read_vect_al_r (varname, vector)
  character(len=*), intent(in) :: varname
  real(wp), allocatable, intent(out) :: vector(:) 
  
  integer(c_int) :: res
  
  type(c_ptr) :: data
  real(c_double), pointer :: fdata(:)
  
  integer(c_int) :: rank
  integer(c_int) :: ishape(20) !! maximum rank constrained to 20

   !! write (*, *) 'read_vect_al_r'
   
   res = octave_load (trim (varname) // c_null_char, &
                      data, rank, ishape)
   
   !! write (*, *) 'res = ', res

   if (res .ne. 0) then

     write(text,'(a, a, a)') &
          'Problem reading variable "', trim (varname), '".'

     call warning ('read_octave_binary', &
          'mod_octave_io_binary', text)
   else
   
     call c_f_pointer (data, fdata, ishape(1:rank))

     allocate (vector (maxval (ishape)))
     vector = real (fdata, wp)
     res =  octave_clear ()

   endif
   
 end subroutine read_vect_al_r

!-----------------------------------------------------------------------
  
 subroutine read_mat_al_r (varname, matrix)
   
  character(len=*), intent(in) :: varname
  real(wp), allocatable, intent(out) :: matrix(:, :) 
  
  integer(c_int) :: res 
  
  type(c_ptr) :: data
  real(c_double), pointer :: fdata(:,:)
  
  integer(c_int) :: rank
  integer(c_int) :: ishape(20)
   
   !! write (*, *) 'read_vect_al_r'

   res = octave_load (trim (varname) // c_null_char, &
                      data, rank, ishape)

   !! write (*, *) 'res = ', res
   
   if (res .ne. 0) then
      
     write(text,'(a, a, a)') &
          'Problem reading variable "', trim (varname), '".'
     
     call warning ('read_octave_binary', &
          'mod_octave_io_binary', text)
   else

     call c_f_pointer (data, fdata, ishape(1:rank))

     allocate (matrix (ishape(1), ishape(2)))
     matrix = real (fdata, wp)
     res = octave_clear ()

   endif
   
 end subroutine read_mat_al_r

!-----------------------------------------------------------------------
  
 subroutine read_scal_r (varname, s)
   
  character(len=*), intent(in) :: varname
  real(wp), intent(out) :: s
  
  integer(c_int) :: res 
  
  type(c_ptr) :: data
  real(c_double), pointer :: fdata
  
  integer(c_int) :: rank
  integer(c_int) :: ishape(20)

   !! write (*, *) 'read_vect_al_r'

   res = octave_load (trim (varname) // c_null_char, &
                      data, rank, ishape)
   
   !! write (*, *) 'res = ', res
   
   if (res .ne. 0) then
      
     write(text,'(a, a, a)') &
          'Problem reading variable "', trim (varname), '".'
     
     call warning ('read_octave_binary', &
          'mod_octave_io_binary', text)
   else
   
     call c_f_pointer (data, fdata, ishape)

     s = real (fdata, wp)
     res =  octave_clear ()

   endif
   
 end subroutine read_scal_r

!-----------------------------------------------------------------------

 subroutine write_vect_r (varname, vector)
   
  character(len=*), intent(in) :: varname
  real(wp), intent(in) :: vector(:) 
  
  integer(c_int) :: res     
  integer(c_int) :: rank = 1 
  integer(c_int) :: shape(1)

   shape(1) = size (vector)

   res = octave_save (trim (varname) // c_null_char, &
                 real (vector, c_double), rank, shape)
   
   !! write (*, *) 'res = ', res

   if (res .ne. 0) then

     write(text,'(a, a, a)') &
          'Problem writing variable "', trim (varname), '".'

     call warning ('read_octave_binary', &
          'mod_octave_io_binary', text)
   endif
   
 end subroutine write_vect_r

!-----------------------------------------------------------------------

 subroutine write_mat_r (varname, matrix)
   
  character(len=*), intent(in) :: varname
  real(wp), intent(in) :: matrix(:,:) 
  
  integer(c_int) :: res     
  integer(c_int) :: rank = 2
  integer(c_int) :: shape(2)

   shape(1) = size (matrix, 1)
   shape(2) = size (matrix, 2)

   res = octave_save (trim (varname) // c_null_char, &
                 real (matrix, c_double), rank, shape)
   
   !!write (*, *) 'res = ', shape

   if (res .ne. 0) then

      write(text,'(a, a, a)') &
           'Problem writing variable "', trim (varname), '".'

      call warning ('read_octave_binary', &
           'mod_octave_io_binary', text)
   endif
   
 end subroutine write_mat_r

!-----------------------------------------------------------------------

 subroutine write_scal_r (varname, s)
   
  character(len=*), intent(in) :: varname
  real(wp), intent(in) :: s 
  
  integer(c_int) :: res     
  integer(c_int) :: rank = 1
  integer(c_int) :: shape(1)
  real(c_double) :: dummy(1,1)
   
   shape(1) = 1
   dummy = real (s, c_double)

   res = octave_save (trim (varname) // c_null_char, &
                      dummy, rank, shape)
   
   !!write (*, *) 'res = ', shape
   
   if (res .ne. 0) then
      
      write(text,'(a, a, a)') &
           'Problem writing variable "', trim (varname), '".'
      
      call warning ('read_octave_binary', &
           'mod_octave_io_binary', text)
   endif
   
 end subroutine write_scal_r

!-----------------------------------------------------------------------

 subroutine octave_binary_open (filename, mode_in, mode_out)
  character(len=*), intent(in) :: filename
  integer, intent(in) :: mode_in
  integer, intent(out) :: mode_out
  integer(c_int) :: imode
  integer(c_int) :: omode
  integer(c_int) :: res

   !! write (*, *) 'octave_binary_open'
   
   imode = mode_in

   res = octave_io_open (trim (filename) // c_null_char, &
                         imode, omode)

   mode_out = omode

   !! write (*, *) 'res = ', res

 end subroutine octave_binary_open
  
!-----------------------------------------------------------------------

 subroutine octave_binary_close ()
   
  integer(c_int) :: res

   res = octave_io_close ()
   
 end subroutine octave_binary_close

!-----------------------------------------------------------------------

end module mod_octave_io_binary
